COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	PROCEDURE INISCANNER
C00016 00004	!	initialization procedure : INIT,INIT0
C00018 00005	!	preswap,postswap
C00021 00006	!	exit procedure: endit
C00023 ENDMK
C⊗;
ENTRY;
BEGIN "INIT"

DEFINE $INIT=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;


STRING $USERNAME,$ALIAS_ID,$LOGIN_ID;
PROCEDURE INISCANNER;
	BEGIN
	ARRCLR($ENTRY);
	STOKEN←FALSE;
	$TTYFL←NULL;
	$ALFL←"DECLAR.AL";		! default name for input/output file;
	$EPS←0.001;
	DEVICE←TTY_X;	! input is from teletype;
	TTYUP(TRUE);	! all input from teletype to be converted to UPPER case;
	END;

PROCEDURE INIOFFSET;
BEGIN
	ALEVENTOFF←'400;
	ARROFF[#SC]←'401;
	ARROFF[#VT]←'402;
	ARROFF[#RT]←ARROFF[#TR]←ARROFF[#FR]←'403;
 	ARROFF[#EV]←'404;		! ATTENTION;
	ARROFF[#ST]←'405;
 	$SYMOFF←'406;			! ATTENTION: CHECK RUNTIME;
END;

PROCEDURE TMPOFFSET;
BEGIN
	! make 9 new scalars because 10th is already made in AL;
	RPTR(EXPR$)S1,S2;
	$TSCOFF←$SYMOFF;
	$TTROFF←$SYMOFF+10;
	$SYMOFF←$TTROFF+10;
	S1←$SMPDCLPCODE(#SC,9);
	S2←$SMPDCLPCODE(#TR,10);
	$EXECUTE($APPEND(S1,S2));
END;


PROCEDURE INIWORLD;
	BEGIN
	WORLD←ENSYM("STATION",#FR,F_WRLD←MK_REC(#FR));
	FRAME:PNAME[F_WRLD]←"STATION";
	END;

PROCEDURE SETOFFSET(INTEGER INDEX);
	BEGIN
	INTEGER I;
	IF INDEX≠CON_OFFSET AND INDEX≠PRG_OFFSET THEN OUTSTR("error in SETOFFSET")
	  ELSE FOR I←#MIN STEP 1 UNTIL #MAX 
		DO OFFSET[INDEX,I]←OFFSET[CUR_OFFSET,I];
	END;

PROCEDURE SAVRESOFFSET;
	BEGIN
	INTEGER I;
	FOR I←#MIN STEP 1 UNTIL #MAX DO OFFSET[RES_OFFSET,I]←$ENTRY[I];
	END;


PROCEDURE GTARMOFFSET;
	BEGIN
	PROCEDURE FORCESYMBOL(RPTR(SYMBOL)S; INTEGER OFF);
		BEGIN SYMBOL:OFFSET[S]←OFF; SYMBOL:INDEX[S]←0; END;
	INTEGER I,NILROTOFF,NILTRANSOFF;
	RPTR(SYMBOL)TEMP;
	ASKUSER("___ENDASKUSER");
	GTOKEN;
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	FORCESYMBOL(HANDY←CHECK("YHAND",#SC),YHD_ALOFFSET);
	FORCESYMBOL(HANDB←CHECK("BHAND",#SC),BHD_ALOFFSET);
	FORCESYMBOL(YARM←CHECK("YARM",#FR),  YRM_ALOFFSET);
	FORCESYMBOL(BARM←CHECK("BARM",#FR),  BRM_ALOFFSET);
ifc false thenc
	FORCESYMBOL(CHECK("BARM_ERROR",#SC),BARM_ERROR_ALOFFSET);
	FORCESYMBOL(CHECK("YARM_ERROR",#SC),YARM_ERROR_ALOFFSET);
	FORCESYMBOL(CHECK("YHAND_ERROR",#SC),YHAND_ERROR_ALOFFSET);
	FORCESYMBOL(CHECK("BHAND_ERROR",#SC),BHAND_ERROR_ALOFFSET);
	FORCESYMBOL(CHECK("VISE_ERROR",#SC),VISE_ERROR_ALOFFSET);
	FORCESYMBOL(CHECK("DRIVER_ERROR",#SC),DRIVER_ERROR_ALOFFSET);
endc
	NILROTOFF←SYMBOL:INDEX[CHECK("NILROT",#RT)];
	NILTRANSOFF←SYMBOL:INDEX[CHECK("NILTRANS",#TR)];
	OFFSET[ARM_OFFSET,#SC]←OFFSET[CUR_OFFSET,#SC];
	OFFSET[ARM_OFFSET,#VT]←OFFSET[CUR_OFFSET,#VT];
	OFFSET[ARM_OFFSET,#RT]←NILROTOFF;
	OFFSET[ARM_OFFSET,#TR]←NILTRANSOFF;
	OFFSET[ARM_OFFSET,#FR]←OFFSET[CUR_OFFSET,#FR];
	ASKUSER("AFFIX BGRASP TO BARM AT TRANS(ROT(XHAT,-180),NILVECT); ___ENDASKUSER");
	GTOKEN;
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	END;

PROCEDURE INIBRK;
BEGIN
STRING BTABLE,LETDIGS;
BTABLE←"¬#:<>≤≥≡≠⊂⊃={}.,;[]()+-*/←↑↓→?α$|⊗"&LF&CR&TAB&FF&SP&dquote;
LETDIGS←"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890";
SETBREAK ($CRTAB ←GETBREAK,CR,LF&FF,"INSK");
SETBREAK ($FFTAB ←GETBREAK,FF,NULL,"INSK");
SETBREAK ($RETAB ←GETBREAK,BTABLE,NULL,"INR");		! used by gtoken;
SETBREAK ($SKTAB ←GETBREAK,BTABLE,NULL,"INS");
SETBREAK ($SPCTAB←GETBREAK,TAB&SP,NULL, "XNR");
SETBREAK ($ALFTAB←GETBREAK,NULL,NULL,"XRN");
SETBREAK ($NUMTAB←GETBREAK,"@+-0123456789",NULL,"XNR");	! as table 10;
SETBREAK ($DSHTAB←GETBREAK,"_",NULL,"INS");		! used by COPY/MERGE;
SETBREAK ($ERRTAB←GETBREAK,BTABLE,SP&CR,"IN");		! used while recovering;
SETBREAK ($BSKTAB←GETBREAK,NULL,SP,"IN");		! used to eliminate blanks;
SETBREAK ($DPYTAB←GETBREAK,CR,CRLF,"INS");		! used for display;
SETBREAK ($LTTAB← GETBREAK,LETDIGS,NULL,"INR");
SETBREAK ($NLTTAB←GETBREAK,LETDIGS,NULL,"XNR");
SETBREAK ($RBTAB← GETBREAK,NULL,RUBOUT,"IN");
$BLANK←"                                        ";
SETFORMAT(0,3);
END;

BOOLEAN PROCEDURE FILE_ABSENT(STRING FNAME);
BEGIN "check if FNAME exists"
	INTEGER INPCH,BRCHR,EOF;
	BOOLEAN E;
	OPEN(INPCH←GETCHAN,"DSK",0,3,0,1000,BRCHR,EOF);
	LOOKUP(INPCH,FNAME,EOF);
	E←EOF;
	RELEASE(INPCH);
	RETURN(E);
END;

PROCEDURE INIFILE;
BEGIN "read initialization file"
! check for initialization file on current area, and if absent, get from
	[PNT,HE];
	STRING FID; BOOLEAN ECHO;
	ECHO←FALSE;
	FID←"POINTY.INI";
	IF FILE_ABSENT(FID) THEN FID←FID&"[PNT,HE]";
	READCODE(FID,ECHO);
END;

PROCEDURE INIUSRFILE(STRING FNAME);
BEGIN	! check for initialization file if any;
	BOOLEAN FOO;
	IF FILE_ABSENT(FNAME) THEN RETURN ELSE READCODE(FNAME,FOO);
END;

PROCEDURE CONSTDATA;
	BEGIN
	! read in and set up temporary scalars;
	ASKUSER("SCALAR "&RUBOUT&"I1, "&RUBOUT&"I2,"&RUBOUT&"I3, "&RUBOUT&"I4, "
			&RUBOUT&"I5; ___ENDASKUSER
");
	GTOKEN;
	SETOFFSET(PRG_OFFSET);
	WHILE NOT EQU(TOKEN,"___ENDASKUSER") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	INIFILE;
	GTOKEN;
	WHILE NOT EQU(TOKEN,"_____END____INIT") DO
	BEGIN
	    STOKEN←TRUE;
	    PARSE;
	    GTOKEN;
	END;
	MTYDEVSTACK;
	END;

SIMPLE INTEGER PROCEDURE GETHOUR;
	RETURN( CALL(0,"TIMER") DIV 216000);

PROCEDURE INIMSG; 
BEGIN	"Print message of the day"
	STRING MESSGE;
	INTEGER BRCHAR,CHAN,EOF,FLAG;
	INTEGER FFBREAK;
	INTEGER HOUR; STRING $HOUR;
	IF (HOUR←GETHOUR)<12 THEN $HOUR←"Morning"
		 ELSE IF HOUR < 17 THEN $HOUR←"Afternoon"
			ELSE $HOUR←"Evening";
	PRINT("Hello..."&$USERNAME&"...Good "&$HOUR,CRLF);
	OPEN(CHAN←GETCHAN,"DSK",0,10,0,1000,BRCHAR,EOF);
	LOOKUP(CHAN,"PNTMSG.INI[PNT,HE]",FLAG);
	SETBREAK(FFBREAK←GETBREAK,FF,NULL,"ISN");
	MESSGE←INPUT(CHAN,FFBREAK);
	OUTSTR(MESSGE);
	RELEASE(CHAN);
	RELBREAK(FFBREAK);
END;

PROCEDURE GETUSERNAME;
α
	STRING LINE,WORD,GARB;
	INTEGER BRCHAR;
	INTEGER RCHAN,RBRCHAR,REOF,RFLAG;
	INTEGER CRBREAK,TABBREAK;
	STRING ID,ALIAS_NAME,LOGIN_NAME;
	ID←CVXSTR(CALL(0,"DSKPPN"));	! look at alias;
	$ALIAS_ID←ID[4 TO 6];
	ID←CVXSTR(CALL(0,"GETPPN"));	! look at login ppn;
	$LOGIN_ID←ID[4 TO 6];
	OPEN(RCHAN←GETCHAN,"DSK",0,2,0,1000,RBRCHAR,REOF);
	LOOKUP(RCHAN,"USERS.DAT[PNT,HE]",RFLAG);
	SETBREAK(CRBREAK←GETBREAK,'15,'12&'14,"ISN");
	SETBREAK(TABBREAK←GETBREAK,'11,'14,"ISN");
	ALIAS_NAME←LOGIN_NAME←NULL;
	WHILE NOT REOF DO
		α "GETALINE"
		STRING PN;
		LINE←INPUT(RCHAN,CRBREAK);
		PN←SCAN(LINE,TABBREAK,BRCHAR);
		IF EQU($ALIAS_ID,PN) THEN ALIAS_NAME←LINE;
		IF EQU($LOGIN_ID,PN) THEN LOGIN_NAME←LINE;
		β;
	RELBREAK(CRBREAK);
	RELBREAK(TABBREAK);
	RELEASE(RCHAN);
	IF ALIAS_NAME THEN $USERNAME←ALIAS_NAME
		ELSE IF LOGIN_NAME THEN $USERNAME←LOGIN_NAME
			ELSE α
				OUTSTR("I haven't met you before, what is your name?  ");
				$USERNAME←INCHWL;
				OUTSTR("Please send a message to MSM that you'd like POINTY to recognize you.
");			     β;

β;

PROCEDURE INIINTERRUPT;
BEGIN
intmap(15,esc_I,0);		! set mapping for interrupt handler;
enable(15);			! enable the interrupt handler;
$ESC_I←FALSE;
END;

PROCEDURE INIDISPLAY;
BEGIN
IFC #DISPL THENC INIDPY;ENDC
IFC #DISPL THENC ARRCLR($DISPLAYLIST,NULL); UPDATE;ENDC
END;


BOOLEAN WANT$SYSOUT;

PROCEDURE INIPHOTO;
BEGIN
EXTERNAL INTEGER INIACS;
INTEGER ARRAY F[0:3]; INTEGER I;
STRING FILE;
	FOR I←0 STEP 1 UNTIL 3 DO F[I]←MEMORY[LOCATION(INIACS)+I];
	FILE←CVXSTR(F[0])&"."&CVXSTR(F[1])[1 TO 3]&"["&CVXSTR(F[3])[1 TO 3]&
		","&CVXSTR(F[3])[4 TO 6]&"]";
	$SYSFL←"POINTY.PHT[PNT,HE]";
	$SYSCH←ORAFILE($SYSFL,
	   FF&"{ WRITTEN BY "&FILE&" AT "&DAT_STR&" for ALIAS PPN = "&$ALIAS_ID
	   &CRLF&" LOGIN PPN = "&$LOGIN_ID&" USERNAME = "&$USERNAME&"}"&CRLF,FALSE);
	IF $SYSCH=-1 THEN
		BEGIN PRINT("Terminal session will not be saved on system file",CRLF);
			$SYSOUT←FALSE;
		END ELSE $SYSOUT←TRUE;
	WANT$SYSOUT←$SYSOUT;
END;

SIMPLE PROCEDURE INITTYTYPE;
	BEGIN
	INTEGER I; STRING J;	J←TTYTYPE;
	FOR I←MAX_TTY STEP -1 UNTIL 1 DO IF EQU($TTYNAME[I],J) THEN DONE;
	$TTYTYPE←I;
	END;
!	initialization procedure : INIT,INIT0;
INTERNAL PROCEDURE INIT;
	BEGIN
	$ALLOW←1;	! dont do any displays ;
	GETUSERNAME;	! get the user name ;
	INIMSG;		! print initial message;
	ALINIT;
	RESTRT11;	! restart at the starting point;
	REASSI(0,"ARM");! makes sure ARM is deassigned if we hit call;
	INISCANNER;	! initialize the scanner;
	ARRCLR(OFFSET);	! clear data array of offsets;
	INIOFFSET;	! initialize arroff,varoff,byvar;
			! dont change order of above two because inimaxoffset
				clears the array;
	INIBRK;		! initialize break tables;
	INIWORLD;
	CONSTDATA;	! read in constant data;
	SETOFFSET(CON_OFFSET);
			! remember the current offsets;
	SAVRESOFFSET;
	GTARMOFFSET;	! keep offsets for arms;
	TMPOFFSET;	! set up temporary variables;
	$ALLOW←0;	! enable displays;
	INIINTERRUPT;	! set up interrupts - <esc> I ;
	INIDISPLAY;	! initialize display;
	INIPHOTO;	! initialize the recording session;
	INITTYTYPE;	! find out the terminal type;
	INIUSRFILE("PNTIN0.PNT");
	oldpcdbuf←getpcdbuf;
	END;

REQUIRE INIT INITIALIZATION;

INTERNAL PROCEDURE INIT0;
	BEGIN
	$ALLOW←1;
	GETUSERNAME;
	INIMSG;
	$ALLOW←0;
	END;
!	preswap,postswap;

!	these two routines are responsible for setting up things before saving
	the core image and swapping, and for setting up the i/o channels after
	swapping: they should be called only by the swap routine;

INTERNAL PROCEDURE PRESWAP;
BEGIN
! remember which channels are open, close all output files, complain about
	input files;
IF $OUT THEN CRAFILE($TTYCH);
IF $SYSOUTαTHEN CRAFILE($SYSCH);
REASSI(CALL(0,"PJOB"),"ARM");	! make sure we have the ARM attached to us ;
$USERNAME←$ALIAS_ID←$LOGIN_ID←NULL;
END;


PROCEDURE REOPENFILES;
BEGIN
! setup desired channels again;
IF $OUT THEN 
    BEGIN $TTYCH←ORAFILE($TTYFL,"{ continued writing again at "&dat_str&"}"&CRLF,FALSE);
	IF $TTYCH=-1 THEN 
		BEGIN PRINT("WILL DISCONTINUE WRITING IN ",$TTYFL,CRLF);
			$OUT←FALSE; END;
    END;
IF WANT$SYSOUT THEN
BEGIN
$SYSCH←ORAFILE($SYSFL,"{ continued writing again at "&DAT_STR&"}"&CRLF,FALSE);
IF $SYSCH=-1 THEN
	BEGIN IF $SYSOUT THEN PRINT("WILL DISCONTINUE WRITING IN ",$SYSFL,CRLF);
		WANT$SYSOUT←$SYSOUT←FALSE;
	END;
END;
END;

INTERNAL PROCEDURE POSTSWAP(BOOLEAN SAMECOREIMAGE);
BEGIN
IF SAMECOREIMAGE THEN REOPENFILES
	ELSE BEGIN INIPHOTO; INITTYTYPE; END;
INIINTERRUPT;
REASSI(0,"ARM");
ALINIT;
CALL(CVSIX("POINTY"),"SETNAM");
INIUSRFILE("PNTINI.PNT");
END;
!	exit procedure: endit;

INTERNAL PROCEDURE ENDIT;
BEGIN
INTEGER HOUR; STRING $HOUR;
IF $SYSOUT THEN
	BEGIN
CPRINT($SYSCH,"{exiting at "&DAT_STR,CRLF,"	$FPMAX=",$FPMAX,CRLF,
	"	$INTMAX=",$INTMAX,CRLF,
	"	$PCDMAX=",$PCDMAX,"}",CRLF);
CRAFILE($SYSCH);
	END;

IF $OUT THEN BEGIN PRINT("CLOSING FILE ",$TTYFL); CRAFILE($TTYCH); END;
HOUR←GETHOUR;
BRK_N;

IF HOUR<5 THEN $HOUR←"please get some sleep, you've been working late"
	ELSE IF HOUR <15 THEN $HOUR←"have a nice day"
	ELSE IF HOUR <20 THEN $HOUR←"have a nice evening"
	ELSE $HOUR←"good night, and pleasant dreams";

PRINT("Bye,bye, ..."&$USERNAME&"... "&$HOUR,CRLF);
PRINT("Some interesting statistics:.....",CRLF,
	"$FPMAX=",$FPMAX,"; $INTMAX=",$INTMAX,";$PCDMAX=",$PCDMAX,CRLF);
REASSI(0,"ARM");	! to avoid forgetting to deassign;
CALL(1,"EXIT");			! allow continuation if desired ;
	! following code is executed in case user changes his mind and
		wants to continue where he left off;
REOPENFILES;
END;

END;